home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / Dev / Oberon / source / ProjectOberon / OberonClock.mod < prev    next >
Text File  |  1995-07-02  |  3KB  |  106 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: OberonClock.mod $
  4.   Description: Implementation of the Oberon System date/time routines.
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 1.2 $
  8.       $Author: fjc $
  9.         $Date: 1995/06/04 23:24:07 $
  10.  
  11.   Copyright © 1995, Frank Copeland.
  12.   This file is part of the Oberon-A Library.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.  
  15. *************************************************************************)
  16.  
  17. <*STANDARD-*>
  18.  
  19. MODULE OberonClock;
  20.  
  21. IMPORT SYS := SYSTEM, d := Dos;
  22.  
  23. (*------------------------------------*)
  24. PROCEDURE ADOS2OberonTime * (VAR ds : d.Date; VAR time, date : LONGINT);
  25. (*
  26.   Adapted from ParseDate() in module Dates, Copyright 1987 by:
  27.     Dale W. Thompson, 14500 Dallas Pkwy. #2091, Dallas, TX 75240
  28. *)
  29.  
  30.   VAR year, month, day, hour, min, sec : LONGINT;
  31.       Days     : ARRAY 12 OF INTEGER;
  32.       LeapDays : ARRAY 12 OF INTEGER;
  33.  
  34.    PROCEDURE Leap ( year : LONGINT ) : BOOLEAN;
  35.    BEGIN
  36.       RETURN ((year-1976) MOD 4) = 0
  37.    END Leap;
  38.  
  39. BEGIN (* ADOS2OberonTime *)
  40.   hour := ds.minute DIV 60;
  41.   min := ds.minute MOD 60;
  42.   sec := ds.tick DIV d.ticksPerSecond;
  43.  
  44.   Days[0]  := 31;  LeapDays[0]  := 31;
  45.   Days[1]  := 28;  LeapDays[1]  := 29;
  46.   Days[2]  := 31;  LeapDays[2]  := 31;
  47.   Days[3]  := 30;  LeapDays[3]  := 30;
  48.   Days[4]  := 31;  LeapDays[4]  := 31;
  49.   Days[5]  := 30;  LeapDays[5]  := 30;
  50.   Days[6]  := 31;  LeapDays[6]  := 31;
  51.   Days[7]  := 31;  LeapDays[7]  := 31;
  52.   Days[8]  := 30;  LeapDays[8]  := 30;
  53.   Days[9]  := 31;  LeapDays[9]  := 31;
  54.   Days[10] := 30;  LeapDays[10] := 30;
  55.   Days[11] := 31;  LeapDays[11] := 31;
  56.  
  57.   day := ds.days;
  58.   year := 1978;
  59.   LOOP
  60.     IF Leap (year) THEN
  61.       IF day < 366 THEN
  62.          EXIT;
  63.       ELSE
  64.          DEC( day,366 );
  65.       END;
  66.     ELSE
  67.       IF day < 365 THEN
  68.          EXIT;
  69.       ELSE
  70.          DEC( day,365 );
  71.       END;
  72.     END;
  73.     INC (year);
  74.   END; (* LOOP *)
  75.   INC (day);
  76.  
  77.   month := 0;
  78.   IF Leap (year) THEN
  79.     WHILE day > LeapDays [month] DO
  80.       DEC (day, LeapDays [month]);
  81.       INC (month);
  82.     END;
  83.   ELSE
  84.     WHILE day > Days [month] DO
  85.       DEC (day, Days [month]);
  86.       INC (month);
  87.     END;
  88.   END;
  89.   INC (month);
  90.  
  91.   time := (hour * 64 + min) * 64 + sec;
  92.   date := (year * 16 + month) * 32 + day;
  93. END ADOS2OberonTime;
  94.  
  95. (*------------------------------------*)
  96. PROCEDURE GetClock * (VAR time, date : LONGINT);
  97.  
  98.   VAR ds : d.Date;
  99.  
  100. BEGIN (* GetClock *)
  101.   d.DateStamp (ds);
  102.   ADOS2OberonTime (ds, time, date);
  103. END GetClock;
  104.  
  105. END OberonClock.
  106.